home *** CD-ROM | disk | FTP | other *** search
/ MacHack 1994 / MacHack 1994.toast / MacHack™94 / Talks & Papers / Timothy Knox / yerk 3.66 / Supplement / my stuff / magnify < prev    next >
Text File  |  1994-06-24  |  3KB  |  131 lines
  1. \ rfl    sample use for class copier. A simple magnifying glass.
  2. \         need to load source 'offscreen' first
  3.  
  4. \ include copyBits
  5.  
  6. :CLASS xferer <super copier
  7.  
  8.     var        srcPort        \ source port for copying from
  9.     rect    srcRect        \ source rectangle for copying from
  10.  
  11.   :M sourceRect: put: srcRect ;M
  12.   :M sourcePort: +base put: srcPort ;M
  13.   :M drawDestRect: pushPort set: [ obj: destPort ]
  14.     get: destRect put: temprect -1 -1 inset: temprect draw: temprect
  15.     popPort ;M
  16.  
  17.   :M rowBytes: ( -- n) size: srcRect drop 15 + 4 >> 1 << ;M
  18.  
  19.   :M new: { \ myBitMap rows -- }
  20.     get: myWindow +base put: destPort
  21.     pushPort
  22.     open: self
  23.     rowBytes: self -> rows                \ calc rowbytes
  24.     rows size: srcRect swap drop *        \ calc size of bitmap
  25.     heap> bitMap -> myBitMap            \ create bitmap on heap
  26.     rows get: srcRect put: myBitMap        \ init bitmap
  27.     myBitMap put: offScreen                \ store pointer for disposing
  28.     set: self                            \ set bitmap to grafport
  29.     myBitMap +base call setPortBits
  30.     get: srcRect ^base 16 + put: rect
  31.     popPort ;M
  32.  
  33.   :M save: obj: srcPort 2+ ^base 2+ +base
  34.     abs: srcRect (abs) 16 +
  35.     word0 0 call copyBits ;M    \ write over previous
  36.  
  37.   :M offsetDest: ( dx dy -- ) offset: destRect ;M
  38.   :M offsetSource: ( dx dy -- ) offset: srcrect ;M
  39.  
  40.   :M moveDestTo: { x y -- } x getTopX: destRect - y getTopY: destRect -
  41.     offset: destRect ;M
  42.   :M moveSourceTo: { x y -- } x getTopX: srcrect - y getTopY: srcrect -
  43.     offset: srcrect ;M
  44.  
  45. ;CLASS
  46.  
  47. :CLASS funnyWind <super window
  48.  
  49. \ hold down option key during content click to move window
  50.   :M CONTENT: mods: fevent $ 800 and
  51.     IF abs: self where: fevent -1000 dup 1000 dup put: temprect
  52.         abs: temprect call dragWindow
  53.     ELSE exec: content
  54.     THEN ;M
  55.  
  56.   :M NEW: grayRgn true setDrag: self
  57.         100 200 156 256 put: temprect
  58.         temprect 0 0 dlgWind true true new: super ;M
  59.  
  60. ;CLASS
  61.  
  62.  
  63. \ since we don't have a resource file definition, define a cursor class.
  64. :CLASS MCursor <super warray
  65.  
  66.   :M set: idxBase +base call setCursor ;M
  67.  
  68. ;CLASS
  69.  
  70. 34 MCursor squareCurs
  71.  
  72. \ load with bits for a square cursor
  73. hex
  74.     0000 0000 7ffc 4004
  75.     4004 4004 4004 4004
  76.     4004 4004 4004 4004
  77.     4004 4004 7ffc 0000
  78.  
  79.     0000 fffe fffe c006
  80.     c006 c006 c006 c006
  81.     c006 c006 c006 c006
  82.     c006 c006 fffe fffe
  83.     0008 0007
  84.  
  85. decimal
  86.  
  87. put: squareCurs
  88.  
  89. xferer bob
  90. funnyWind suz
  91.  
  92. new: suz
  93.  
  94. \ don't have a resource file here
  95. \ " magnify" openresfile
  96.  
  97. 0 0 55 55 destrect: bob
  98. 0 0 11 11 sourceRect: bob
  99. fwind sourcePort: bob
  100. suz destPort: bob
  101. new: bob
  102. set: fwind
  103.  
  104. \ If we had a cursor defined in a resource file, with ID=1000
  105. \   we could just say: '1000 cursor magcurs', and not have to define
  106. \  class MCursor
  107.  
  108. : magCurs set: squareCurs ;
  109.  
  110.  
  111. \ one way to execute a magnifier is to hold the mouse button down
  112. : magnify magcurs
  113.     BEGIN
  114.         where: theMouse 5 - swap 5 - swap moveSourceto: bob
  115.         save: bob draw: bob 
  116.         stilldown? not
  117.     UNTIL arrowcurs ;
  118.  
  119. 4 'cfas null null null magnify actions: fwind
  120.  
  121. \ load this for another way
  122. \ : magnify2 getRect: fwind put: temprect
  123. \     word0 where: theMouse pack abs: temprect call ptInRect i->l
  124. \     IF magCurs where: theMouse 5 - swap 5 - swap moveSourceto: bob
  125. \         save: bob draw: bob
  126. \     ELSE arrowcurs
  127. \     THEN ;
  128. \ 
  129. \ 'c magnify2 setidle: fwind
  130.     
  131.